perm filename PASS3.SAI[HAL,HE]12 blob
sn#239539 filedate 1976-09-29 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00018 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 IFCR ¬DECLARATION(EXTENDED_COMPILATION)
C00006 00003 ! Declarations, overall description
C00009 00004 ! EMITOFFSET, EMITSMLBLK
C00015 00005 ! EMITEXPR: ONEARG, TWOARGS, THREEARGS
C00019 00006 ! EMITEXPR: variable, constant, specval, force
C00024 00007 ! EMITEXPR: expression
C00030 00008 ! EMITBOOL
C00034 00009 ! TSCAN: STMNT, VARIABLE, PROG
C00038 00010 ! TSCAN: BLOCK
C00051 00011 ! TSCAN: COBLOCK
C00054 00012 ! TSCAN: FORR, WHIL, IFF, PAUSE, ABORT
C00061 00013 ! TSCAN: ASSIGNMENT, PRNT, GASSIGN, ALSODO
C00066 00014 ! TSCAN: CMON, CMABLE
C00070 00015 ! TSCAN: MOVE$, CENTER, STOP, COMMENT, AFFIX, UNFIX
C00079 00016 ! TSCAN: EVDO, SPECVAL
C00080 00017 ! NULL, UNRECOGNIZED, Matching ENDs
C00081 00018 ! Bugs
C00082 ENDMK
C⊗;
IFCR ¬DECLARATION(EXTENDED_COMPILATION)
THENC
ENTRY;
BEGIN "PASS3"
IFCR ¬DECLARATION(CREFFING) THENC DEFINE CREFFING = "FALSE"; ENDC
IFCR ¬ CREFFING THENC
COMMENT: Source file requirements;
REQUIRE "ABBREV.SAI[HAL,HE]" SOURCE_FILE;
REQUIRE "RECAUX.HDR[HAL,HE]" SOURCE_FILE;
REQUIRE "ARITH.HDR[HAL,HE]" SOURCE_FILE ;
REQUIRE "HALREC.SAI[HAL,HE]" SOURCE_FILE ;
ENDC
REDEFINE $$PRGID "[]" = ["PASS3"];
IFCR CREFFING THENC REQUIRE $$PRGID MESSAGE; ENDC
REQUIRE "EMITER.HDR[HAL,HE]" SOURCE_FILE;
REQUIRE "INTDEF.SAI[HAL,HE]" SOURCE_FILE;
ENDC
REQUIRE "EMITER.REL[HAL,HE]" LOAD_MODULE;
! Standard emitter;
! REQUIRE "TCALC.HDR[HAL,HE]" SOURCE_FILE;
EXTERNAL PROCEDURE TRJCLC(RANY MOV; RANY ITEMVAR WORLD);
EXTERNAL PROCEDURE CENTCLC(RANY MOV);
EXTERNAL PROCEDURE STOPCLC(RANY MOV);
! Declarations, overall description;
RCELL USEDVARS; ! A list of variables as they appear. Used to
generate the needed list of graph node calculators;
! The word that heads a constant gives its type. These are they:;
DEFINE SCLID = 1;
DEFINE VCTID = 2;
DEFINE TRNID = 3;
! This file contains all the routines necessary for implementing the
third pass of HAL, that is, the code generator.
The principal routine is TSCAN, which generates code for the root of
the bound parse tree and calls itself recursively for the rest. The
structures in this tree are defined in HALREC[HAL,RHT], page three.
TSCAN is a large IF-THEN-ELSE-IF-THEN chain which determines which of
the various possible structures is present. If it is some kind of
statement, then appropriate pseudo-code is emitted. The preparation
of this code may require that code for the evaluation of an
expression. Such code is prepared in the recursive procedure
EMITEXPR, which performs type-consistency checking (but not constant
folding, which could be done here). Code for boolean tests is
prepared by EMITBOOL.
¬
All code emission is done through the routine EMIT, to be found in
EMITER.SAI, which takes arguments specifying what output file to use
(e.g., pseudo-code or constant area), the data to output, and whether
to treat it as an instruction, an octal constant, a label
declaration, or repeatedly to produce the rel file. ;
! EMITOFFSET, EMITSMLBLK;
INTERNAL PROCEDURE EMITOFFSET(INTEGER PC;RVAR VARBL);
BEGIN "emitoffset"
! Outputs into the file PC the offset of VARBL, making a remark;
INTEGER DUMY;
MAKE_REMARK(PC,CVIS(VARIABLE:NAME[VARBL],DUMY));
EMIT(PC,VARIABLE:OFFSET[VARBL],CONST);
END "emitoffset";
INTEGER PROCEDURE EMITSMLBLK
(INTEGER LENGTH; REFERENCE REAL FIRST_ELT; BOOLEAN REF (FALSE));
BEGIN "emitsmlblk"
! Emits a constant in the small block area. The length is
given, as is the first element, so that the whole thing can be
grabbed by location. Note that LENGTH must not be greater than
3. The label of the block is returned as the result if REF is
true, otherwise, no label is emitted.
;
OWN INTEGER ARRAY DATA [1:7]; ! 2*maxlength + 1 long;
INTEGER ARRAY RELOC [1:7];
INTEGER J, ADDR, K;
IF LENGTH > 3
THEN BEGIN
COMERR("EMITSMLBLK cannot handle length = " & CVS(LENGTH));
LENGTH ← 3;
END;
IF REF
THEN BEGIN
DATA[1] ← GENLABEL;
RELOC[1] ← SYMDEC;
K ← 2;
END
ELSE K ← 1; ! Place for next entry in DATA, RELOC;
ADDR ← LOC(FIRST_ELT);
FOR J ← 0 STEP 1 UNTIL LENGTH-1 DO
BEGIN "convert";
INT_TO_11FLOAT(DATA[K],DATA[K+1],MEM[ADDR + J,REAL]);
RELOC[K] ← RELOC[K+1] ← CONST;
K ← K + 2;
END "convert";
EMIT(SMLBLK,DATA[1],RELOC[1],K-1);
RETURN(IF REF THEN DATA[1] ELSE -1);
END "emitsmlblk";
! EMITEXPR: ONEARG, TWOARGS, THREEARGS;
INTERNAL RECURSIVE INTEGER PROCEDURE EMITEXPR (REXPR XPRESS);
! Emits code for XPRESS, the value of which is to be left at top
of stack, returns the type of the expression. FRAME_DTYPE is
never returned. It is coerced to TRANS_DTYPE;
BEGIN "emitexpr"
INTEGER RTYPE, DTYPE;
RECURSIVE PROCEDURE ONEARG(INTEGER ARG1TYPE,OPERATION,RESTYPE);
BEGIN ! Pick up one argument, evaluate;
REXPR XXX;
XXX ← XPRESS; ! because of a SAIL Bug;
MAKE_REMARK(PSDCODE,"first argument");
IF EMITEXPR(CELL:CAR[EXPRN:ARGS[XXX]]) ≠ ARG1TYPE
THEN COMERR("Wrong type of argument",XXX);
EMIT(PSDCODE,OPERATION,PSINST);
DTYPE ← RESTYPE;
END;
RECURSIVE PROCEDURE TWOARGS
(INTEGER ARG1TYPE,ARG2TYPE,OPERATION,RESTYPE);
BEGIN ! Pick up two arguments, evaluate them;
DEFINE CADR(X) = "CELL:CAR[CELL:CDR[X]]";
REXPR XXX;
XXX ← XPRESS; ! because of a SAIL Bug;
MAKE_REMARK(PSDCODE,"first argument");
IF EMITEXPR(CELL:CAR[EXPRN:ARGS[XXX]]) ≠ ARG1TYPE
THEN COMERR("Wrong type for first argument",XXX);
MAKE_REMARK(PSDCODE,"second argument");
IF EMITEXPR(CADR(EXPRN:ARGS[XXX])) ≠ ARG2TYPE
THEN COMERR("Wrong type for second argument",XXX);
EMIT(PSDCODE,OPERATION,PSINST);
DTYPE ← RESTYPE;
END;
RECURSIVE PROCEDURE THREEARGS
(INTEGER ARG1TYPE,ARG2TYPE,ARG3TYPE,OPERATION,RESTYPE);
BEGIN ! Pick up three arguments, evaluate;
DEFINE CADR(X) = "CELL:CAR[CELL:CDR[X]]";
DEFINE CADDR(X) = "CELL:CAR[CELL:CDR[CELL:CDR[X]]]";
REXPR XXX;
XXX ← XPRESS; ! because of a SAIL Bug;
MAKE_REMARK(PSDCODE,"first argument");
IF EMITEXPR(CELL:CAR[EXPRN:ARGS[XXX]]) ≠ ARG1TYPE
THEN COMERR("Wrong type for first argument",XXX);
MAKE_REMARK(PSDCODE,"second argument");
IF EMITEXPR(CADR(EXPRN:ARGS[XXX])) ≠ ARG2TYPE
THEN COMERR("Wrong type for second argument",XXX);
MAKE_REMARK(PSDCODE,"third argument");
IF EMITEXPR(CADDR(EXPRN:ARGS[XXX])) ≠ ARG3TYPE
THEN COMERR("Wrong type for third argument",XXX);
EMIT(PSDCODE,OPERATION,PSINST);
DTYPE ← RESTYPE;
END;
! EMITEXPR: variable, constant, specval, force;
PRELOAD_WITH PUSH_PSOP, DUMMY;
OWN INTEGER ARRAY DATA[0:1];
PRELOAD_WITH PSINST, SYMREF;
OWN INTEGER ARRAY RELOC [0:1];
INTEGER LAB;
RTYPE ← RECTYPE(XPRESS);
! A variable?;
IF RTYPE = LOC(VARIABLE)
THEN BEGIN "variable"
EMIT(PSDCODE,GTVAL_PSOP,PSINST);
EMITOFFSET(PSDCODE,XPRESS);
DTYPE ← VARIABLE:DATATYPE[XPRESS];
USEDVARS ← CONS(XPRESS,USEDVARS);
END "variable"
! A constant?;
ELSE IF RTYPE = LOC(SVAL)
THEN BEGIN "scalar"
EMIT(SMLBLK,SCLID,CONST); ! Header for typing;
LAB ← EMITSMLBLK(1,SVAL:VAL[XPRESS],TRUE);
DATA[1] ← LAB;
EMIT(PSDCODE,DATA[0],RELOC[0],2);
DTYPE ← SVAL_DTYPE;
END "scalar"
ELSE IF RTYPE = LOC(V3ECT)
THEN BEGIN "vector"
EMIT(SMLBLK,VCTID,CONST); ! Header for typing;
LAB ← EMITSMLBLK(3,V3ECT:X[XPRESS],TRUE);
EMITSMLBLK(1,1.0); ! This puts the scale factor in;
DATA[1] ← LAB;
EMIT(PSDCODE,DATA[0],RELOC[0],2);
DTYPE ← V3ECT_DTYPE;
END "vector"
ELSE IF RTYPE = LOC(ROTN)
THEN BEGIN "rot" ! Will output the equivalent trans;
EMIT(SMLBLK,TRNID,CONST); ! Header for typing;
LAB ← EMITSMLBLK(3,ROTN:RMX[XPRESS][1,1],TRUE);
EMITSMLBLK(1,0.0); ! This puts the fourth row in;
EMITSMLBLK(3,ROTN:RMX[XPRESS][2,1]);
EMITSMLBLK(1,0.0); ! This puts the fourth row in;
EMITSMLBLK(3,ROTN:RMX[XPRESS][3,1]);
EMITSMLBLK(1,0.0); ! This puts the fourth row in;
EMITSMLBLK(3,V3ECT:X[NILVECT]); ! The fourth column;
EMITSMLBLK(1,1.0); ! This puts the fourth row in;
DATA[1] ← LAB;
EMIT(PSDCODE,DATA[0],RELOC[0],2);
DTYPE ← ROTN_DTYPE;
END "rot"
ELSE IF RTYPE = LOC(TRANS)
THEN BEGIN "trans"
EMIT(SMLBLK,TRNID,CONST); ! Header for typing;
LAB ← EMITSMLBLK(3,ROTN:RMX[TRANS:R[XPRESS]][1,1],TRUE);
EMITSMLBLK(1,0.0); ! This puts the fourth row in;
EMITSMLBLK(3,ROTN:RMX[TRANS:R[XPRESS]][2,1]);
EMITSMLBLK(1,0.0); ! This puts the fourth row in;
EMITSMLBLK(3,ROTN:RMX[TRANS:R[XPRESS]][3,1]);
EMITSMLBLK(1,0.0); ! This puts the fourth row in;
EMITSMLBLK(3,V3ECT:X[TRANS:P[XPRESS]]); ! The fourth column;
EMITSMLBLK(1,1.0); ! This puts the fourth row in;
DATA[1] ← LAB;
EMIT(PSDCODE,DATA[0],RELOC[0],2);
DTYPE ← TRANS_DTYPE;
END "trans"
ELSE IF RTYPE = LOC(FRAME)
THEN BEGIN "frame" ! Recursive call to pick up the trans inside;
EMITEXPR(FRAME:VAL[XPRESS]);
DTYPE ← FRAME_DTYPE;
END "frame"
! A specval?;
ELSE IF RTYPE = LOC(SPECVAL)
THEN BEGIN "specval"
IF SPECVAL:OLD[XPRESS]
THEN EMIT(PSDCODE,GTO@→λa!'∨ 1!'∪≥M(R~∀% →'
↓ ≠∪(!!' π=
Y∂Q≥ .1A'↔ YA'∪≥'PRv~∀% )3!∀A>A'A π-β0u)3!∃71!%∃'':v4∀∪ ≥⊂@Ega∃GmCXλ~∀~∀@@@BAαAM=eGJ}l~∀@@A →'∀A∪ AI)3!
zA→∨ Q
∨%
R~∀@@A)! ≤A¬∃∂∪≤@ M←eG∀D~∀@@@@@A ≠∪PQ!'
∨
Y≥ )
∨Iπ
1!M∨ Y!M∪≥'($v~∀@@@@@A ≠∪PQ!'
∨
Y→∨%π
i∨
'∃)71!I '':1π∨≥'PRv~∀@@@@@A )e!
A>↓'-β_a )3!∀v~∀@@@@@A ≥λEM←e
JD~∀_B@A∃≠∪) a!$t@↓Kqae∃ggS←8v~∀~(@@@@∧@Aβ\↓Kqae∃ggS←8}v~∀@@A 1'
A∪_A%)3A
@zA1∨εQ a!%≤R4∀@@@↓)⊃ ≤↓¬ ∂∪8@EeK
kegJλ~∀∪∪9) ∂ HA∨!$l~∀∪∨A$A>A∃1!%≤i∨!71A% ''tv~∀∪% A∨!H@x@`>A∨!H@:A→¬'(1∨@~∀∪)! ≤A¬∃∂∪≤~(∩@@@↓π∨≠ I$PE∪1YKOC0AKqaIKggS=\DY1A% '&$v~∀∩@@A Q3!
A|@`v~(∩@@@↓ ≥λ~(∪ →'∀Aπβ'∀A∨!$↓∨ ~∀@@@@@@@@A¬ ∂%≤@EG¬gJD~(@@@@@@@@@A7≥<1∨!:4∀∩∪ Q3!
A|A ≠∪Q 1!$!π →_iπβ%7∃1!%≤iβ%∂'m1!% M';:Rl~∀@@@@@@@@@Am'β λa∨!:~(∩∪)/=β%∂&!'-β_a )3!∀Y'-β01 )3A
Y'β⊃λ1!'= Y'-¬_1 )e!
Rv4∀@@@@@@@@@A7M≥ ∞1=!:~∀$∪∨≥ ¬%∞Q'Yβ_1 Q3!
YM≥ ∞1A'∨ YM-β_1⊃)3!
$v~∀@@@@@@@@@↓7''+λ1∨!:4∀∩∪)]∨β%∂LQ'-β01 )3A
Y'-¬_1 )e!
Y'M+∧1!M∨ Y'Yβ_1 Q3!
Rl~∀@@@@@@@@@Am'≠+_a∨!:~(∩∪)/=β%∂&!'-β_a )3!∀Y'-β01 )3A
Y'≠U_1!'= Y'-¬_1 )e!
Rv4∀@@@@@@@@@A7M ∪,1=!:~∀$∪)/∨¬%∂&QM-β_1⊃)3!
1'-β_a )3!∀Y' ∪X1!'∨@Y'-β01 )3A
Rv~(@@@@@@@@@A7'1(1∨!t@~∀∩%)/∨βI∂&Q'Yβ_1 Q3!
YM-β_1⊃)3!
1'→(1A'∨ YM-β_1⊃)3!
$v~∀@@@@@@@@@↓7' "a∨!:@4∀∩∪)]∨β%∂LQ'-β01 )3A
Y'-¬_1 )e!
Y'∃"1!'= Y'-¬_1 )e!
Rv4∀@@@@@@@@@A7M→
1∨A:@~∀$∪)/∨¬%∂&QM-β_1⊃)3!
1'-β_a )3!∀Y'→
a!'∨ 1'-β_a )3!∀Rv~∀@@@@@@@@A7'∂∀1∨!:~∀∩∪Q/∨β%≥&Q'-¬_1 )e!
Y'Yβ_1 Q3!
YM∂
1!M∨ Y'Yβ_1 Q3!
Rl~∀@@@@@@@@@Am'≥
1=!:@~(∩∪)/=β%∂&!'-β_a )3!∀Y'-β01 )3A
Y'≥∀1!'∨@Y'-β01 )3A
Rv~(@@@@@@@@@A7'≥(1∨!t@~∀∩%)/∨βI∂&Q'Yβ_1 Q3!
YM-β_1⊃)3!
1'∂(1A'∨ YM-β_1⊃)3!
$v~∀@@@@@@@@@↓7β≥λa∨!:@4∀∩∪)]∨β%∂LQ'-β01 )3A
Y'-¬_1 )e!
Yβ9λ1!'= Y'-¬_1 )e!
Rv4∀@@@@@@@@@A7=$1∨!t@~∀∩%)/∨βI∂&Q'Yβ_1 Q3!
YM-β_1⊃)3!
1→∨$1A'∨ YM-β_1⊃)3!
$v~∀@@@@@@@@@↓7≥∨(a∨!:@4∀∩∪∨9 β%∞!'-β_a )3!∀Y≥∨(a!'∨ 1'-β_a )3!∀Rv~∀@@@@@@@@A7-≠¬∂≤1∨A:~∀∩%∨≥ βI∞Q,g∃π(1 Q3!
YY≠β∂≤a!'∨ 1'-β_a )3!∀Rv~∀@@@@@@@@A7- =(1∨!t~∀∩∪Q/∨β%≥&Q,g∃π(1 Q3!
YXg π(a )3!∀Y- ∨P1!'∨@Y'-β01 )3A
Rv~(@@@@@@@@@A7%5β∂≤1=!:~∀$∪∨≥ ¬%∞Q%=)≤1 Q3!
YQ≠β∂≤a!'∨ 1'-β_a )3!∀Rv~∀@@@@@@@@A7β1%&1∨!t~∀∩∪=≥ β%≤Q%∨)81 )3A
Y)βa∪&1!M∨ Y,M π(1⊃)3!
$v~∀@@@@@@@@@↓7-≠β-
1∨!t~∀∩∪Q⊃% ¬%∂&QM-β_1⊃)3!
1'-β_a )3!∀Y'-β01 )3A
Y-≠¬↔
1!M∨ Y,M π(1⊃)3!
$v~∀@@@@@@@@@↓7'-≠U_1∨!t~∀∩∪Q/∨β%≥&Q'-¬_1 )e!
Y,M π(1⊃)3!
1'-≠+01!'∨@Y,g
(1 )e!
Rv4∀@@@@@@@@@A7Yβ λ1=!:~∀$∪)/∨¬%∂&QXg π(a )3!∀Y,g
(1 )e!
Y-¬ λ1!M∨ Y,M π(1⊃)3!
$v~∀@@@@@@@@@↓7-'+λ1∨!:4∀∩∪)]∨β%∂LQ,g
(1 )e!
Y,M π(1⊃)3!
1-'+∧a!'∨ 1,g πP1 )3A
Rv~(@@@@@@@@@A7%Y≠+_1=!:~∀$∪)/∨¬%π&QI∨)≤1⊃)3!
1,g πP1 )3A
Y)-5+_1!M∨ Y,M π(1⊃)3!
$v~∀@@@@@@@@@↓7)-≠U_1∨!t~∀∩∪Q/∨β%≥&Q)%¬≥&1 Q3!
YXg π(a )3!∀Y)-≠U_1!'= Y,g∃π(1 Q3!
Rl~∀@@@@@@@@@Am+- πP1∨!:4∀∩∪∨9 β%∞!,g πP1 )3A
Y+≥%),1!M∨ Y,M π(1⊃)3!
$v~∀@@@@@@@@@↓7!∨&a∨!:~(∩∪∨≥∃β%∞QQ%β≥&a )3!∀Y)!∨L1!'∨@Y,g
(1 )e!
Rv4∀@@@@@@@@@A7=%∪ ≥P1∨!:4∀∩∪∨9 β%∞!)%β≥L1 )3A
Y)∨I∪ ≤1A'∨ YI∨)≤1⊃)3!
$v~∀@@@@@@@@@↓7β1.a%∨)≤a∨!:~(∩∪)/=β%∂&!,g πP1 )3A
Y'-¬_1 )e!
Y-Mβ1/$a!'∨ 1%∨)≤a )3!∀Rv~∀@@@@@@@@A7)≠¬↔
1∨A:~∀∩%)/∨βI∂&Q%=)≤1 Q3!
YXg π(a )3!∀Y)≠β-
1!'= Y)%³&1 Q3!
Rl~∀@@@@@@@@@Am)-β ⊂1∨!:4∀∩∪)]∨β%∂LQ)%β9&1 )e!
Y,M π(1⊃)3!
1)-β ⊂1!'∨@Y)%β9&1 )e!
Rv4∀@@@@@@@@@A7Q-'+∧a∨!:~(∩∪)/=β%∂&!)%β≥L1 )3A
Y,g∃π(1 Q3!
YQ-'+∧a!'∨ 1)%β≥L1 )3A
Rv~(@@@@@@@@@A7%I≠+_1=!:~∀$∪)/∨¬%∂&QI∨)≤1⊃)3!
1%∨)≤a )3!∀Y))≠U_1!'= Y%∨Q≤1 )e!
Rv4∀@@@@@@@@@A7Q)≠+_a∨!:~(∩∪)/=β%∂&!)%β≥L1 )3A
Y)%³&1 Q3!
YQ)≠+_a!'∨ 1)%β≥L1 )3A
Rv~(@@@@@@@@@A7)%≥-%(a∨!:~(∩∪∨≥∃β%∞QQ%β≥&a )3!∀Y)∪≥Y%(1!M∨ Y)Iβ≥&1⊃)3!
$v~∀@@@@@@@@@↓7 !H1∨!:4∀∩∪ Q3!
A|A ≠∪Q 1!$!π →_iπβ%7
→_u
%7 a!%≤u¬%∂'7a!% 'M;;:Rl~∀@@@@@@@@@Am
≠β↔∀1∨!:4∀∩∪)]∨β%∂LQ%∨)81 )3A
Y,g∃π(1 Q3!
YQ≠β↔
a!'∨ 1)%β≥L1 )3A
Rv~(∩@@@↓7∪≥-¬→∪λ1=!:~∀$∪π∨≠∃%$PE%]mCY%HA←a∃eCi←HDY1!I '&R4∀@@@@@@@@@A 9λ@EG¬gJDv4∀@@@@@@A% A )e!
@6↓ 1!%8u β)¬)3! m1!% M':@λ~∀∩∩ A )3A
@6AQ%β≥&a )3!∀@@>@↓ 1!%8u β)¬)3! m1!% M':@6↓
%β≠∀1 )3A
@R~(@@@@@@A)! ≤Aπ=≠ %$ E)sa∀AG←]MSgiK9GrAKIe←dA%\A ≠%) 1!Ht@D@_Aπ-&! )3!∀R@LD6@D@_~∀@@@@@@@@@A
-&Q a!%≤u⊃β)β)e! 71A% ''tR@L@λ\DY1A% '&$v~∀∪∃≥λ@EIKGkeMJD~∀4∀@@@↓ →'
↓¬ ∂∪8~∀∪π=≠ %$ E∂Ce COJA∃qaeKMgS←\λY1!%∃'&Rv4∀∪ )e!
A>`v~∀% ≥λv4∀~∀@@A∪ ↓ )3!∀@zA
Iβ≠
1⊃)3!
↓)⊃ ≤↓ )3!∀A>A)Iβ≥&1⊃)3!
l~∀@@A% )U%≤Q Q3!
Rl~∀@@A ≥λEK[SQKqadλv~∀_B@A∃≠∪)¬=∨_v~(~∃!%=π +I
A ≠%)¬∨∨0Q% 1A$Aπ∨9 ∪)∪=≤vA∪9) ∂ HA 'Q)%+
P`RX↓ ')→β→'
P`RRl~∀@@A¬ ∂%≤@@E∃[SiE=←XD~(@@@@∧@A∂K9KeCi∃fAG←⊃JAi↑↓KmCYUCiJAQQJAG=]ISi%←\\@↓∪DASPAgkG
KKIf0~∀@@AiQKIJAgQ=kYHA JABA)k[`AQ↑A M))%+∀XASL↓MCYg∀XAi↑↓ ')→β→'
8@A∪L4∀@@@↓KSiQ∃dASf`XAS9giKC⊂A←LA)k[aS9NAiQ∃eJXA→CYXAQQe←k≥Pv~∀4∀@@@BA[←⊃SMSK⊂AErA¬eN@r4bhZnXv~∀~(@@@A% A M)
β→M
~∀@@A)⊃∃≤A¬ ≥∪≤@E→Uk[`λ~∀∩B↓!khAQQJAi∃giKH↓eKgk1hA←\↓iQJAMiCGVl~∀∪∪_A ≠∪Q 1!$!π∨≥ %)∪∨≤$@6A'Yβ_1 Q3!
~(∪)⊃ 8Aπ∨≠∃%$PE9←\[g
CYCd↓E←←Y∃C\DY
∨≥ ∪Q∪∨≤Rl~∀@@@@@@↓ ≠∪(PSDCODE,JUMPC_PSOP,PSINST,1); ! JUMPC;
EMIT(PSDCODE,DESTFALSE,SYMREF,1); ! (ref) DESTFALSE;
IF DESTTRUE
THEN BEGIN "tfjump"
EMIT(PSDCODE,JUMP_PSOP,PSINST,1); ! JUMP;
EMIT(PSDCODE,DESTTRUE,SYMREF,1); ! (ref) DESTTRUE;
END "tfjump"
END "fjump"
ELSE IF DESTTRUE
THEN BEGIN "tjump"
! Put the tested result on the stack;
IF EMITEXPR(CONDITION) ≠ SVAL_DTYPE
THEN COMERR("Non-scalar boolean",CONDITION);
EMIT(PSDCODE,NOT_PSOP,PSINST,1); ! Take the complement of the boolean;
EMIT(PSDCODE,JUMPC_PSOP,PSINST,1); ! JUMPC;
EMIT(PSDCODE,DESTTRUE,SYMREF,1); ! (ref) DESTTRUE;
END "tjump";
END "emitbool";
! TSCAN: STMNT, VARIABLE, PROG;
INTERNAL RECURSIVE PROCEDURE TSCAN (RANY PARSETREE);
BEGIN "tscan"
! TSCAN takes a parse tree and interprets its nodes, calling
appropriate routines to prepare code for each node;
INTEGER STYP, ! Statement type;
LAB1, LAB2, LAB3, LAB4;
! Save labels across recursive calls. Cannot
save in DATA since that is an OWN array;
RPTR(STMNT) STATEMENT;
LABEL MIDLABEL, ENDLABEL; ! This is to prevent parse stack overflow;
OWN INTEGER OFS; ! The current offset for variables;
INITIALIZE (OFS ← '34);
STYP ← RECTYPE(PARSETREE);
IF STYP = LOC(STMNT) THEN
BEGIN "stmnt"
! Eventually will want to output labelling information here;
STATEMENT ← PARSETREE;
PARSETREE ← STMNT:SEMANTICS[PARSETREE];
IF PARSETREE = RNULL THEN RETURN;
STYP ← RECTYPE(PARSETREE);
END "stmnt";
IF STYP = LOC(VARIABLE) ∨ STYP = LOC(DBD) ∨ STYP = LOC(PVL)
∨ STYP = LOC(NW) THEN
! Just ignore it. Variable declarations are treated with
block entry and exit. Others handled only during world modelling;
ELSE IF STYP = LOC(PROG) THEN
BEGIN "prog"
MAKE_REMARK(PSDCODE,"Start of program");
EMIT(PSDCODE,PROG_PSOP,PSINST); ! Make mechanism variables;
TSCAN(PROG:CODE[PARSETREE]);
EMIT(PSDCODE,ENDP_PSKP,PSINST); ! Clean up mechanism variables;
MAKE_REMARK(PSDCODE,"End of program");
CLOSEOQT; ! Closes the output file;
END "prog"
! TSCAN: BLOCK;
ELSE IF STYP = LOC(BLOCK) THEN
BEGIN "block"
RCELL C; ! Holds variable list and current tail of block;
INTEGER DUMY, SAVOFS; ! Holds OFS for the duration;
RVAR VARBL; ! Temporary: variable under consideration;
MAKE_REMARK(PSDCODE,"BLOCK");
SAVOFS ← OFS; ! We will assign new offsets in this block.
! Declare non-global variables;
C ← BLOCK:VARS[PARSETREE];
IF C ≠ RNULL
THEN EMIT(PSDCODE,MVAR_PSOP,PSINST); ! variable declaration;
WHILE C ≠ RNULL DO
BEGIN "vardec"
VARBL ← LLOP(C);
IF ¬GLBAL_ON(VARIABLE:ATTRIBUTES[VARBL])
THEN BEGIN ! List each non-global variable;
VARIABLE:OFFSET[VARBL] ← OFS ← OFS+2;
EMITOFFSET(PSDCODE,VARBL);
EMITOFFSET(SYMFIL,VARBL);
END;
END "vardec";
IF BLOCK:VARS[PARSETREE] ≠ RNULL
THEN EMIT(PSDCODE,0,CONST); ! zero at end of variable list;
! Link global variables;
C ← BLOCK:VARS[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "glbdec"
VARBL ← LLOP(C);
IF GLBAL_ON(VARIABLE:ATTRIBUTES[VARBL])
THEN BEGIN ! List each global variable;
INTEGER R50; ! Holds the radix 50 of the name;
INTEGER TEMP;
EMIT(PSDCODE,GLBLNK_PSOP,PSINST);
VARIABLE:OFFSET[VARBL] ← OFS ← OFS+2;
EMITOFFSET(PSDCODE,VARBL);
EMITOFFSET(SYMFIL,VARBL);
R50 ← CVSIX(CVIS(VARIABLE:NAME[VARBL],DUMY));
TEMP ← R50 LAND '177777; ! First part of name;
EMIT(PSDCODE,TEMP,CONST);
TEMP ← (R50 LSH -16) LAND '177777; ! Second part of name;
EMIT(PSDCODE,TEMP,CONST);
END;
END "glbdec";
! Declare each event;
C ← BLOCK:EVTS[PARSETREE];
IF C ≠ RNULL
THEN EMIT(PSDCODE,MAKEVT_PSOP,PSINST);
WHILE C ≠ RNULL DO
BEGIN ! List each event;
VARBL ← LLOP(C);
VARIABLE:OFFSET[VARBL] ← OFS ← OFS+2;
EMITOFFSET(PSDCODE,VARBL);
EMITOFFSET(SYMFIL,VARBL);
END;
IF BLOCK:EVTS[PARSETREE] ≠ RNULL
THEN EMIT(PSDCODE,0,CONST); ! zero at end of event list;
! Set up force variables;
C ← BLOCK:FORCES[PARSETREE];
IF C ≠ RNULL
THEN MAKE_REMARK(PSDCODE,"Form force variable");
WHILE C ≠ RNULL DO
BEGIN "blkforce"
! <put fdirect and mdirect on stack> MAKFORCE <offset> <mech. bits>;
RPTR(FORCE) FRC;
FRC ← LLOP(C);
EMITEXPR(FORCE:FDIRECT[FRC]); ! The direction;
EMITEXPR(FORCE:MDIRECT[FRC]); ! The moment;
EMIT(PSDCODE,MAKFORCE_PSOP,PSINST);
EMIT(PSDCODE,FORCE:OFFSET[FRC]←OFS←OFS+2,CONST);
EMIT(PSDCODE,'4,CONST); ! For now, only can use blue arm;
END "blkforce";
! Form each condition monitor;
C ← BLOCK:CMONS[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "blkcmon"
INTEGER CTYPE; ! 0 for expression or variable, 1 for event;
RPTR(CMON) MONITOR;
MONITOR ← LLOP(C);
! JUMP_PSOP LAB1 (ref), (dec) LAB2: "condition monitor
checker" CMSKED, <time: 100 for variable, 0 forevent>,
[<code for boolean condition, if variable>], CMTRIG,
<code for conclusIon>, JUMP (ref) LAB2, "create condition
monitor", (dec) LAB1: CMMAK <offset>, <event to wait for
or 0> (ref) LAB2;
CTYPE ← IF RECTYPE(CMON:CONDITION[MONITOR]) = LOC(VARIABLE)
AND VARIABLE:DATATYPE[CMON:CONDITION[MONITOR]] = EVENT_DTYPE
THEN 1 ELSE 0;
EMIT(PSDCODE,JUMP_PSOP,PSINST); ! Jump to declaration;
LAB1 ← GENLABEL; ! Declaration;
EMIT(PSDCODE,LAB1,SYMREF);
MAKE_REMARK(PSDCODE,"Condition monitor checker");
LAB2 ← GENLABEL; ! start address;
EMIT(PSDCODE,LAB2,SYMDEC);
EMIT(PSDCODE,CMSKED_PSOP,PSINST);
IF CTYPE = 0
THEN BEGIN "cmexpr" ! An expression to be evaluated;
EMIT(PSDCODE,100,CONST); ! Waiting interval;
EMITBOOL(CMON:CONDITION[MONITOR],0,LAB2);
END "cmexpr"
ELSE BEGIN "cmevt" ! An event to wait for;
EMIT(PSDCODE,0,CONST); ! Waiting interval;
END "cmevt";
EMIT(PSDCODE,CMTRIG_PSOP,PSINST);
TSCAN(CMON:CONCLUSION[MONITOR]);
EMIT(PSDCODE,JUMP_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMREF);
MAKE_REMARK(PSDCODE,"Create condition monitor");
EMIT(PSDCODE,LAB1,SYMDEC);
EMIT(PSDCODE,CMMAK_PSOP,PSINST);
EMIT(PSDCODE,CMON:OFFSET[MONITOR]←OFS←OFS+2,CONST);
IF CTYPE = 0
THEN EMIT(PSDCODE,0,CONST) ! No event to wait for;
ELSE ! Wait for event;
EMITOFFSET(PSDCODE,CMON:CONDITION[MONITOR]);
EMIT(PSDCODE,LAB2,SYMREF);
END "blkcmon";
! Form the calculators local to this block;
C ← BLOCK:CLCS[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "blkclc"
RVAR ITEMVAR NEED;
RPTR(CALCULATOR) CALC;
CALC ← LLOP(C);
! MEXP_PSOP, <needed list>, <0>, SYMREF (LAB1), <offset> ;
EMIT(PSDCODE,MEXP_PSOP,PSINST);
FOREACH NEED SUCH THAT NEED IN CALCULATOR:NEEDED[CALC] DO
EMITOFFSET(PSDCODE,∂(NEED));
EMIT(PSDCODE,0,CONST);
LAB1 ← GENLABEL;
EMIT(PSDCODE,@→βλbY'35%β Rl~∀@@@@@@@@@A
β→π+1β)∨$i∨
'∃)7πβ1π:A>↓∨
&A|A∨
&V@dv4∀@@@@@@@@@A 5∪(Q!M π∨ ∀Y∨
&1π∨≥'PRv~∀@@@@@@@@@B@A)+≠ 1A'⊂≡AbαNf6∀*→↓"d
I%bα2ε Q↓s∂}#∃β≠⎇⊃β↔cπ∪↔OON{9y0hQ↓↓↓α↓↓↓↓α↓↓↓↓α↓α⊗:$~2 b¬~>A1∧bε IR↓l4)α↓↓↓↓α↓↓↓↓αα⊗6&"BBN∩≤z∩∃2U*6@b¬~>A2¬~&:N"Il4)α↓↓↓↓α↓↓↓↓αα2ε ⊂α⎇α≡,r2ε
,al4)α↓↓↓↓α↓↓↓↓αα⊗6&"BBN∩≤z∩∃2d
I2≥J6J⊗2Il4)α↓↓↓↓α↓↓↓↓αα⊗6&"BBN∩≤z∩∃2d
E2≥J6∩⊗~Il4)α↓↓↓↓α↓↓↓↓αα⊗6&$*bBID~ε2∞,bεR>∪R~>JmZ∞ε2≥i%l4R↓↓↓↓α↓↓↓↓α↓α⊗6M!"BN$~>∩∃d*:∩∞d_bBN⎇↓2BNLrNQ%Xh)↓↓α↓↓↓↓α↓↓↓α,j&Q"¬~∩∞>$)22ε∪⊃2Nfl"⊗
%Xh)↓↓α↓↓↓↓α↓↓↓α,r⊃↓ ⊗c/∂3~⊃l4(hP%¬↓∧;↔;↔⊗ S∃β&C∃β∂}#∃β≠␈⊃βS#*βOSπ&+7↔;'→β'9π##∃β⊗c?∂-Xh)↓↓α↓↓↓↓∧→α⎇α∀b>∞-T~>∩⊗]αεJN-"J⊗⊗kX4)↓α↓↓↓↓αα↑"&d)α
ZαJ:Vdaα∩<hQ↓↓↓α↓↓↓↓α↓↓αR≤~ε9"db>A"~I%l4Ph(&6 Z∀bJ,jεJ-EαN∩∞|"∃1
⊗c?∂-ε+;⊃β≡c↔π;/↓ %lhP4(%
↓α∨↔"βK'⊃ε{→β∂}s∪'SN{9β7}s'S?↔→l4(L→α⎇α∀b>∞-T~6>:≥ZBεJ≤*RJ⊗-il4(LJ→α
↓YαJ:,b04(M""⊗9∧*6&QEαN∩∞|"∃2∞l"⊗NPEαN>AeαN&:≥!%l4PJ↑"&d)α
ZαJ:Vdaα∩<hP%↓↓α↓¬↓αfKOQβ. ∂!βn{;'S␈⊃l4)α↓↓↓↓α↓↓↓↓αα⊗6&"BBN∩≤z∩∃2≤j>9j|2~N⊗%Z22>αB
&ud~>:N"Im↓↓
β?≠≠≡+Ql4PJ&→α∀b>∞-T~6>:≥ZBεJ≤*RJ⊗-imα∀rV20hP&R",qα⊗6M!"BN$~>∩∃c↓2∞>u~Q%mα↓¬βk/∪=βπ"β↔;⊃ε{→β∂}s⊃9βn{99βfKOQlhP4(%
↓α∨↔"βK'⊃ε{→β≠␈∪∂∃β6 K'π⊗c↔MlhP&
αzα
2>≤Yj~>∀~⊗Nn∧
JN⊗%∩⊗⊗uXh(&↑DJ2∃α~mαJu*21α$x4)↓α↓↓↓↓α↓↓↓↓∧∩⊗≡&ph)↓↓α↓↓↓↓α↓↓↓α,j&Q"¬~∩∞>$)2∩⊗≤2>J∞)BBN>αbBN&u~Q%lhQ↓↓↓α↓↓↓↓α↓↓α⊗lJQ"B≤"∞>∩*b~>J≤)j>~5~⊗Rndb>A"~Ju2∞|rNQ%Z↓↓¬β}3≠O↔#X4)↓α↓↓↓↓α↓↓↓↓∧*:⊃lhP4(%
↓α∨↔"βK'⊃ε{→β;}q7∨3}∪π1β6 K'π⊗c↔MlhP&
αzα
2>≤YjZε∃~nBε∃~⊗RJ,*ul4PJ&→α~mαJu*204PJR"⊗rα⊗6&"BBN∩≤z∩∃2]2εHb¬~>A2¬~&:N"Il4(M:"&2*α
m¬∩:V2bα∩<4PI↓↓↓∧∩⊗≡&r↓ [π↔∪↔5λhP%↓↓ααZεJ∀aα⎇αdb>A"~Il4)α↓↓↓↓α↓↓↓↓αα&→,:2
εaB>9"4
J&ε∀b∃jε%"J&
-"⊗Nn4
J
2jH4)↓α↓↓↓↓α↓↓↓↓¬""⊗9α ↓α3O≠Qβ↔∞≠!β;}q7∨3}∪π1β6 K'π⊗c∃l4R↓↓↓↓α↓↓↓↓α↓↓↓↓αα⊗6&$z~~N-!"BN$~>∩∃e2εJ
bIl4(J↓↓↓α,r⊃↓ 6 KK↔j⊃l4(LJ→α
dz∞-j4
JNn∧
JN⊗%∩⊗⊗u↓YαJ:,b04(M""⊗9∧*6&QEαN∩∞|"∃1Ad~>:N"Im↓↓
βk↔KzβπQβ.s⊃β?2β[πKN 3∃εc'OQXh(4(J ↓α∨/!βK'"β?→β/3↔;S≠X4(&~α⎇α
dz∞-j-2RNn∧
JN⊗%∩⊗⊗uXh(&&2α
m¬∩:V2`h(&RD*9α⊗lJQ"B≤"∞>∩*b∩⊗N-2PbB≤zA2B≤J:NQKY↓↓¬π3πK'∞∪3∃β⊗+7?[∞al4(M:"&2*α
m¬∩:V2bα∩<4PI↓↓↓α ↓α3O≠Qβ↔∞≠!β↔6+;QlhQ↓↓↓α↓↓↓↓α↓↓α⊗lJR>~5~⊗Q"¬~∩∞>$)222⎇↓"
%KX4(&L1α
2|~-j⊗5"NnB
∩N⊗R∀*⊗uZαJ:Vd`4(&$B⊗9α,j&Q"¬~∩∞>$)1A2≤z:NQKY↓↓¬πS↔K=ε Qβ↔v!β?→ε+[↔;"β3'O#X4(4PJ6ε.)BJ⊗6
∩-"B≤"∞>∩*a
↔;"β?→α∀b>∞-∩Il4(hP&>~~α⎇αN
2>~MZ↓↓¬α⊗+OS?⊗)βS#*β?≠≠≡+QβSzβ?K'>K;π1π≠SπS+X4)↓α↓↓↓↓αα⊗:⊃α∪ 3?≡Yλ4( ! TSCAN: COBLOCK;
ELSE IF STYP = LOC(COBLOCK) THEN
BEGIN "coblock"
RCLASS COLAB (INTEGER LBEL; RPTR(COLAB) NEXT);
RPTR (COLAB) LABELS, HERE;
INTEGER SAVOFS; ! Holds OFS for the duration;
RCELL C;
PRELOAD_WITH JUMP_PSOP, DUMMY, ! 1-2;
SPROUT_PSOP, DUMMY, ! 3-4;
TERMINATE_PSOP, ! 5;
DUMMY; ! 6;
INTEGER OWN ARRAY DATA[1:6];
PRELOAD_WITH PSINST, SYMREF, ! 1-2;
PSINST, SYMREF, ! 3-4;
PSINST, ! 5;
SYMDEC; ! 6;
INTEGER OWN ARRAY RELOC[1:6];
HERE ← LABELS ← NEW_RECORD (COLAB);
LAB1 ← DATA[2] ← GENLABEL;
MAKE_REMARK(PSDCODE,"Coblock");
EMIT(PSDCODE,DATA[1],RELOC[1],2); ! Jump to end label;
SAVOFS ← OFS;
OFS ← (OFS LAND '17400) + '410; ! Move to next lexical level, offset 10;
C ← COBLOCK:CODE[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "onecob"
HERE ← COLAB:NEXT[HERE] ← NEW_RECORD(COLAB);
DATA[6] ← COLAB:LBEL[HERE]← GENLABEL;
EMIT(PSDCODE,DATA[6],RELOC[6],1); ! symdec;
MAKE_REMARK(PSDCODE," Costatement");
TSCAN(LLOP(C));
EMIT(PSDCODE,DATA[5],RELOC[5],1); ! Terminate;
EN@ "onecob";
OFS ← SAVOFS; ! Back to prevIous level;
DATA[6] ← LAB1; ! Label for jump around cocode;
EMIT(PSDCODE,DATA[6],RELOC[6],1); ! symdec;
HERE ← COLAB:NEXT[LABELS];
MAKE_REMARK(PSDCODE," epilog of Coblock");
EMIT(PSDCODE,DATA[3],RELOC[3],1); ! Sprout;
WHILE HERE ≠ RNULL DO
BEGIN
DATA[4] ← COLAB:LBEL[HERE];
EMIT(PSDCODE,DATA[4],RELOC[4],1); ! Label of code;
HERE ← COLAB:NEXT[HERE];
END;
EMIT(PSDCODE,0,CONST,1); ! Final zero;
MAKE_REMARK(PSDCODE,"END COBLOCK");
END "coblock"
! TSCAN: FORR, WHIL, IFF, PAUSE, ABORT;
ELSE IF STYP = LOC(FORR) THEN
BEGIN "forr"
! This is how it all should look: [FOR LOOP] <stack initial,
final, step> LAB1: XCOPY 2 (current value) XCHNGE <control
variable> XFORCHK LAB2 <body> XCOPY 0 (step size) XCOPY 3
(current value) XSADD XREPLACE 3 (current value) XJUMP LAB1
LAB2: XPOP XPOP XPOP [END FOR];
MAKE_REMARK(PSDCODE,"FOR LOOP");
EMITEXPR(FORR:INITIAL[PARSETREE]);
! This will emit code for the calculation of the initial
value;
EMITEXPR(FORR:FINAL[PARSETREE]);
! This will emit code for the calculation of the final
value;
EMITEXPR(FORR:STEP[PARSETREE]);
! This will emit code for the calculation of the step
value;
LAB1 ← GENLABEL; ! Top of loop;
LAB2 ← GENLABEL; ! End of loop;
EMIT(PSDCODE,LAB1,SYMDEC);
EMIT(PSDCODE,COPY_PSOP,PSINST);
EMIT(PSDCODE,2,CONST);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,FORR:CONVAR[PARSETREE]);
EMIT(PSDCODE,FORCHK_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMREF);
TSCAN(FORR:BODY[PARSETREE]);
EMIT(PSDCODE,COPY_PSOP,PSINST);
EMIT(PSDCODE,0,CONST);
EMIT(PSDCODE,COPY_PSOP,PSINST);
EMIT(PSDCODE,3,CONST);
EMIT(PSDCODE,SADD_PSOP,PSINST);
EMIT(PSDCODE,REPLACE_PSOP,PSINST);
EMIT(PSDCODE,3,CONST);
EMIT(PSDCODE,JUMP_PSOP,PSINST);
EMIT(PSDCODE,LAB1,SYMREF);
EMIT(PSDCODE,LAB2,SYMDEC);
EMIT(PSDCODE,POP_PSKP,PSINST);
EMIT(PSDCODE,POP_PSOP,PSINST);
EMIT(PSDCODE,POP_PSOP,PSINST);
MAKE_REMARK(PSDCODE,"END FOR");
END "forr"
ELSE IF STYP = LOC(WHIL) THEN
BEGIN "while"
MAKE_REMARK(PSDCODE,"WHILE Loop");
LAB1 ← GENLABEL; ! Loop head;
LAB2 ← GENLABEL; ! After end;
EMIT(PSDCODE,LAB1,SYMDEC); ! (dec) LAB1: ;
EMITBOOL(WHIL:COND[PARSETREE],0,LAB2);
TSCAN(WHIL:BODY[PARSETREE]);
! JUMP (ref) LAB1, (dec) LAB2: ;
EMIT(PSDCODE,JUMP_PSOP,PSINST);
EMIT(PSDCODE,LAB1,SYMREF);
EMIT(PSDCODE,LAB2,SYMDEC);
MAKE_REMARK(PSDCODE,"END WHILE");
END "while"
ELSE IF STYP = LOC(IFF) THEN
BEGIN "iff"
MAKE_REMARK(PSDCODE,"IF");
LAB1 ← GENLABEL; ! The head of the ELSE part;
LAB2 ← GENLABEL; ! At the end of the IF;
EMITBOOL(IFF:COND[PARSETREE],0,LAB1);
MAKE_REMARK(PSDCODE,"THEN");
TSCAN(IFF:THN[PARSETREE]);
! JUMP (ref) LAB2, (dec) LAB1: ;
EMIT(PSDCODE,JUMP_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMREF);
EMIT(PSDCODE,LAB1,SYMDEC);
IF IFF:ELS[PARSETREE] ≠ NULL
THEN BEGIN
MAKE_REMARK(PSDCODE,"ELSE");
TSCAN(IFF:ELS[PARSETREE]);
END;
EMIT(PSDCODE,LAB2,SYMDEC); ! (dec) LAB2: ;
MAKE_REMARK(PSDCODE,"FI");
END "iff"
ELSE IF STYP = LOC(PAUSE) THEN
BEGIN "pause"
MAKE_REMARK(PSDCODE,"PAUSE");
! Get the value on the stack;
EMITEXPR(PAUSE:VAL[PARSETREE]);
EMIT(PSDCODE,PAUSE_PSOP,PSINST);
END "pause"
ELSE IF STYP = LOC(ABORT) THEN
BEGIN "abort"
RCELL C;
MAKE_REMARK(PSDCODE,"ABORT");
EMIT(PSDCODE,ABORT_PSOP,PSINST);
C ← ABORT:VAL[PARSETREE]; ! Get list of print items;
IF C ≠ RNULL THEN MAKE_REMARK(PSDCODE,"Print");
WHILE C ≠ RNULL DO
BEGIN "abort print list"
IF RECTYPE(CELL:CAR[C]) = LOC(STCONST)
THEN BEGIN "prntstr"
INTEGER ADR;
ADR ← LOC(STCONST:VAL[CELL:CAR[C]]);
LAB1 ← GENLABEL;
EMIT(SMLBLK,LAB1,SYMDEC);
EMIT(SMLBLK,ADR,STRCONST);
EMIT(PSDCODE,PRINT_PSOP,PSINST);
EMIT(PSDCODE,LAB1,SYMREF);
END "prntstr"
ELSE BEGIN "prntexpr"
! Get the value on the stack;
EMITEXPR(CELL:CAR[C]);
EMIT(PSDCODE,VALPRN_PSOP,PSINST);
END "prntexpr";
C ← CELL:CDR[C];
END "abort print list";
MAKE_REMARK(PSDCODE,"DDT"); ! Control passes to DDT;
EMIT(PSDCODE,DDT_PSOP,PSINST);
END "abort"
ELSE GO TO MIDLABEL;
GO TO ENDLABEL; ! This is to avoid parse stack overflow;
! TSCAN: ASSIGNMENT, PRNT, GASSIGN, ALSODO;
MIDLABEL: ! Necessary to avoid parse stack overflow;
IF STYP = LOC(ASSIGNMENT) THEN
BEGIN "assignment"
MAKE_REMARK(PSDCODE,"Assignment");
! Get the value on the stack;
EMITEXPR(ASSIGNMENT:VAL[PARSETREE]);
! Emit "change variable to value on stack";
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,ASSIGNMENT:VAR[PARSETREE]);
END "assignment"
ELSE IF STYP = LOC(PRNT) THEN
BEGIN "prnt"
RCELL C;
MAKE_REMARK(PSDCODE,"Print");
C ← PRNT:VAL[PARSETREE]; ! Get list of print items;
WHILE C ≠ RNULL DO
BEGIN "print list"
IF RECTYPE(CELL:CAR[C]) = LOC(STCONST)
THEN BEGIN "prntstr"
INTEGER ADR;
ADR ← LOC(STCONST:VAL[CELL:CAR[C]]);
LAB1 ← GENLABEL;
EMIT(SMLBLK,LAB1,SYMDEC);
EMIT(SMLBLK,ADR,STRCONST);
EMIT(PSDCODE,PRINT_PSOP,PSINST);
EMIT(PSDCODE,LAB1,SYMREF);
END "prntstr"
ELSE BEGIN "prntexpr"
! Get the value on the stack;
EMITEXPR(CELL:CAR[C]);
EMIT(PSDCODE,VALPRN_PSOP,PSINST);
END "prntexpr";
C ← CELL:CDR[C];
END "print list"
END "prnt"
ELSE IF STYP = LOC(GASSIGN) THEN
BEGIN "gassign"
! Only handles GASSIGN:OP = 1 or 2 (is / is not computed by);
RPTR(CALCULATOR,LBLVAR) CLCV;
IF GASSIGN:OP[PARSETREE] = 1
THEN EMIT(PSDCODE,MCLC_PSOP,PSINST) ! Is calculated by;
ELSE IF GASSIGN:OP[PARSETREE] = 2
THEN EMIT(PSDCODE,DCLC_PSOP,PSINST) ! Is not calculated by;
ELSE COMERR("Illegal GASSIGN",PARSETREE);
CLCV ← GASSIGN:CLC[PARSETREE];
IF RECTYPE(CLCV) = LOC(LBLVAR)
THEN CLCV ← LBLVAR:SEMANTICS[CLCV];
EMIT(PSDCODE,CALCULATOR:OFFSET[CLCV],CONST);
EMITOFFSET(PSDCODE,GASSIGN:VAR[PARSETREE]);
END "gassign"
ELSE IF STYP = LOC(ALSODO) THEN
BEGIN "alsodo"
! MCHG_PSOP <offset> (symref LAB1) JUMP_PSOP (symref LAB2)
LAB1: <code for changer> TERMINATE_PSOP LAB2: ;
RPTR(CHANGER,LBLVAR) CHGV;
MAKE_REMARK(PSDCODE,"Also do");
LAB1 ← GENLABEL; ! Start of changer code;
LAB2 ← GENLABEL; ! End of changer code;
EMIT(PSDCODE,MCHG_PSOP,PSINST);
EMITOFFSET(PSDCODE,ALSODO:VAR[PARSETREE]);
EMIT(PSDCODE,LAB1,SYMREF);
EMIT(PSDCODE,JUMP_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMREF);
EMIT(PSDCODE,LAB1,SYMDEC);
CHGV ← ALSODO:CHG[PARSETREE];
IF RECTYPE(CHGV) = LOC(LBLVAR)
THEN CHGV ← LBLVAR:SEMANTICS[CHGV];
TSCAN(CHANGER:CODE[CHGV]);
EMIT(PSDCODE,TERMINATE_PSOP,PSINST);
EMIT(PSDCODE,LAB2,SYMDEC);
END "alsodo"
! TSCAN: CMON, CMABLE;
ELSE IF STYP = LOC(CMON) THEN
BEGIN "cmon"
MAKE_REMARK(PSDCODE,"Enable condition monitor");
EMIT(PSDCODE,CMENBL_PSOP,PSINST);
EMIT(PSDCODE,CMON:OFFSET[PARSETREE],CONST);
END "cmon"
ELSE IF STYP = LOC(CMABLE) THEN
BEGIN "cmable"
RPTR(CMON,LBLVAR) CMONV; ! The CMON;
CMONV ← CMABLE:WHAT[PARSETREE];
IF RECTYPE(CMONV) = LOC(LBLVAR)
THEN CMONV ← LBLVAR:SEMANTICS[CMONV];
IF CMABLE:FLAG[PARSETREE]
THEN BEGIN "enable"
MAKE_REMARK(PSDCODE,"Enable");
EMIT(PSDCODE,CMENBL_PSOP,PSINST); ! CMENBL (offset);
EMIT(PSDCODE,CMON:OFFSET[CMONV],CONST);
END "enable"
ELSE BEGIN "disable"
MAKE_REMARK(PSDCODE,"Disable");
EMIT(PSDCODE,CMDSBL_PSOP,PSINST); ! CMDSBL (offset);
EMIT(PSDCODE,CMON:OFFSET[CMONV],CONST);
END "disable"
END "cmable"
! TSCAN: MOVE$, CENTER, STOP, COMMENT, AFFIX, UNFIX;
ELSE IF STYP = LOC(MOVE$) THEN
BEGIN "move"
RPTR(DEXPR) DESTEXPR; ! The destiniation expression;
RPTR(ARRIVAL) ARR; ! Arrival clause (if any);
RCELL CLAUS; ! The list of clauses;
MAKE_REMARK(PSDCODE,"Move");
! Generate code for all deproaches & via points that are expressions;
CLAUS ← MOVE$:CLAUSES[PARSETREE];
WHILE CLAUS ≠ RNULL DO
BEGIN "mexpr"
RANY THISCLAUSE;
THISCLAUSE ← LLOP(CLAUS);
IF RECTYPE(THISCLAUSE) = LOC(VIA) AND
RECTYPE(DEXPR:EXPN[VIA:ACTPLACE[THISCLAUSE]]) = LOC(EXPRN)
THEN BEGIN "via"
EMITEXPR(DEXPR:EXPN[VIA:ACTPLACE[THISCLAUSE]]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[VIA:ACTPLACE[THISCLAUSE]]);
END "via";
IF RECTYPE(THISCLAUSE) = LOC(DEPARTURE) AND
RECTYPE(DEXPR:EXPN[DEPARTURE:ACTPLACE[THISCLAUSE]]) = LOC(EXPRN)
THEN BEGIN "dep"
EMITEXPR(DEXPR:EXPN[DEPARTURE:ACTPLACE[THISCLAUSE]]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[DEPARTURE:ACTPLACE[THISCLAUSE]]);
END "dep";
IF RECTYPE(THISCLAUSE) = LOC(ARRIVAL)
THEN BEGIN "arr"
ARR←THISCLAUSE;
IF RECTYPE(DEXPR:EXPN[ARRIVAL:ACTPLACE[THISCLAUSE]])=LOC(EXPRN) THEN
BEGIN
EMITEXPR(DEXPR:EXPN[ARRIVAL:ACTPLACE[THISCLAUSE]]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[ARRIVAL:ACTPLACE[THISCLAUSE]]);
END;
END "arr";
END "mexpr";
! Generate code for the destination point, if it is an expression;
DESTEXPR ← MOVE$:DEXP[PARSETREE];
IF RECTYPE(DEXPR:EXPN[DESTEXPR]) = LOC(EXPRN)
THEN BEGIN "movdest" ! Must emit code to evaluate the
destination;
EMITEXPR(DEXPR:EXPN[DESTEXPR]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[DESTEXPR]);
END "movdest";
TRJCLC(PARSETREE,STMNT:IW[STATEMENT]);
! Update deproach variable if need be;
IF ARR≠RNULL THEN
BEGIN
EMIT(PSDCODE,GTVAL_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[ARRIVAL:ACTPLACE[ARR]]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
IF MOVE$:CF[PARSETREE]=BARM THEN EMITOFFSET(PSDCODE,BDEPROACH)
ELSE EMITOFFSET(PSDCODE,YDEPROACH);
END;
END "move"
ELSE IF STYP = LOC(OPERATE) THEN
BEGIN "operate"
RPTR(MOVE$) MOV; ! Fill this in from the OPERATE record;
RPTR(DEXPR) DESTEXPR; ! The destiniation expression;
RCELL CLAUS; ! The list of clauses;
MAKE_REMARK(PSDCODE,"Operate");
IF OPERATE:WHAT[PARSETREE] ≠ BHAND AND
OPERATE:WHAT[PARSETREE] ≠ YHAND
THEN COMERR("Can't OPERATE a non-hand");
MOV ← NEW_RECORD(MOVE$);
MOVE$:WHAT[MOV] ← OPERATE:WHAT[PARSETREE];
MOVE$:DEST[MOV] ← OPERATE:DEST[PARSETREE];
MOVE$:CLAUSES[MOV] ← OPERATE:CLAUSES[PARSETREE];
MOVE$:CF[MOV] ← OPERATE:CF[PARSETREE];
MOVE$:DEXP[MOV] ← OPERATE:DEXP[PARSETREE];
! Generate code for all via points that are expressions;
CLAUS ← MOVE$:CLAUSES[MOV];
WHILE CLAUS ≠ RNULL DO
BEGIN "ovia"
RANY THISCLAUSE;
THISCLAUSE ← LLOP(CLAUS);
IF RECTYPE(THISCLAUSE) = LOC(VIA) AND
RECTYPE(DEXPR:EXPN[VIA:ACTPLACE[THISCLAUSE]]) = LOC(EXPRN)
THEN BEGIN "oprvia"
EMITEXPR(DEXPR:EXPN[VIA:ACTPLACE[THISCLAUSE]]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[VIA:ACTPLACE[THISCLAUSE]]);
END "oprvia";
END "ovia";
! Generate code for the destination point, if it is an expression;
DESTEXPR ← MOVE$:DEXP[MOV];
IF RECTYPE(DEXPR:EXPN[DESTEXPR]) = LGC(EXPRN)
THEN BEGIN "oprdest" ! Must emit code to evaluate the
destination;
EMITEXPR(DEXPR:EXPN[DESTEXPR]);
EMIT(PSDCODE,CHNGE_PSOP,PSINST);
EMITOFFSET(PSDCODE,DEXPR:VAR[DESTEXPR]);
END "oprdest";
TRJCLC(MOV,STMNT:IW[STATEMENT]);
END "operate"
ELSE IF STYP = LOC(CENTER) THEN
BEGIN "center"
MAKE_REMARK(PSDCODE,"Center");
CENTCLC(PARSETREE);
END "center"
ELSE IF STYP = LOC(STOP) THEN
BEGIN "stop"
MAKE_REMARK(PSDCODE,"Stop");
STOPCLC(PARSETREE);
END "stop"
ELSE IF STYP = LOC(COMMNT) THEN
BEGIN "commnt"
END "commnt"
ELSE IF STYP = LOC(AFFIX) THEN
BEGIN "affix"
RCELL C;
MAKE_REMARK(PSDCODE,"Affixment");
C ← AFFIX:GPHCODE[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "afscan"
TSCAN(LLOP(C));
END "afscan";
MAKE_REMARK(PSDCODE,"End of affixment");
END "affix"
ELSE IF STYP = LOC(UNFIX) THEN
BEGIN "unfix"
RCELL C;
MAKE_REMARK(PSDCODE,"Unfixment");
C ← UNFIX:GPHCODE[PARSETREE];
WHILE C ≠ RNULL DO
BEGIN "afscan"
TSCAN(LLOP(C));
END "afscan";
MAKE_REMARK(PSDCODE,"End of unfixment");
END "unfix"
! TSCAN: EVDO, SPECVAL;
ELSE IF STYP = LOC(EVDO) THEN
BEGIN "evdo"
MAKE_REMARK(PSDCODE,"Event operation");
IF EVDO:OP[PARSETREE] = 0
THEN EMIT(PSDCODE,SIGNAL_PSOP,PSINST)
ELSE EMIT(PSDCODE,WAITE_PSOP,PSINST);
EMITOFFSET(PSDCODE,EVDO:VAR[PARSETR@ :$v~∀@@@@@A ≥λEKmI<D~∀~(@@@A∃→'
A% A')e @zA1∨εQ'A π-β0RA)⊃∃≤~∀@@@@@A¬ ∂%≤@EgAKGmC0D~∧@@@@@A∪ AM! π-¬_u∨→⊃7!β%M )% ∃:@zAQ%+
~(@@@@@@A)! ≤A 5∪(Q!M π∨ ∀Y∂)∨1λ1!'= Y!'%≥'(R4∀@@@@@@A∃→'
A∃≠∪(QA' π∨⊃
Y∂)9 .1!M∨ Y!M∪≥'($v~∀@@@@@A ≥λEgaK
mCXD4∀_B@A9+→_X↓+≥%
∨∂≥∪i λXA5CiGQ%]NA 9 fv~(~∀@@A →'∀A∪ AM)3 @tA→∨ε!¬→↔∨@RA∨$4∀@@@@@@AM)3 @tA→∨ε!β'' I(RA∨H~∀@@@@@@↓')3 zA→∨ Q ≥dRA∨$4∀@@@@@@AM)3 @tA→∨ε!!-_R↓∨$~∀@@@@@A')e @zA1∨εQ≥\RA)⊃∃≤@@BA≥↑[=`ACh↓iQJA5←[K]Pv~∀@@A →M
Aπ∨5 %$P πC\OPAOK]∃eCiJ↓G←IJ↓M←dAQQSfD1!β%'∃)%
$v~∀~(@@@A∃≥ →β _t@B@A)!SfASLAQKe∀Ai↑A¬m←SH↓aCeg∀AgiC
VA←m∃eMY←\v~∀@@A ≥⊂@Eig
C\Dv4∃ ≥λHIae≥SHv~( ! Bugs
Global events will not work.
iw=ow=any after a condition monitor
last word of a trans constant is being set to a ridiculoust.
Extra variables are being generated for moves. Can they be suppressed?
;